home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8307.arc / XB.BAS < prev   
BASIC Source File  |  1983-05-06  |  14KB  |  580 lines
  1. 1 ' File:  xb.bas
  2. 2 ' Auth:  Richard Foard
  3. 3 ' Edit:  rmf  13-Mar-83  10:00pm
  4. 4 ' Copyright (c) 1982 Richard M. Foard
  5. 5 '
  6. 6 DIM LABSTK(25),GLABVALS(1000),ULABVALS(1000),ULABTEXT$(1000)
  7. 899 GOTO 1000
  8. 900 DEF FNALPHA(C$)=(C$>="a" AND C$<="z") OR (C$>="A" AND C$<="Z")
  9. 901 DEF FNNUMERIC(C$)=C$>="0" AND C$<="9"
  10. 903 DEF FNUPPER$(C$)=CHR$(+32*(C$>="a")+ASC(C$))
  11. 999 RETURN
  12. 1000 PASS=1
  13. 1010 GOSUB 10000 'initialize
  14. 2000 GOSUB 31000 'readline
  15. 2200 GOSUB 4000 'proc line
  16. 2400 IF NOT(EOF(INCHAN)) THEN 2000
  17. 2460 GOSUB 55000 'pass 2
  18. 2465 GOSUB 55200 'finish ulabs
  19. 2467 GOSUB 55500 'finish errs
  20. 2470 CLOSE INCHAN
  21. 2480 CLOSE OUTCHAN
  22. 2490 PRINT "Compilation complete"
  23. 2500 STOP
  24. 4000 '----------
  25. 4010 ' proc line
  26. 4020 '
  27. 4030 GOSUB 50500 'scan nb
  28. 4032 IF FNNUMERIC(TOKEN$) THEN 4030 'skip line numbers
  29. 4034 WHILE TTYPE=ULAB
  30. 4035   GOSUB 46000 'def ulab
  31. 4036   GOSUB 50500 'scan nb
  32. 4037 WEND
  33. 4039 IF TTYPE=EOL THEN RETURN
  34. 4040 IF TTYPE=SCANERROR THEN RETURN
  35. 4050 IF TTYPE <> SNAME THEN 4600
  36. 4060 IF TOKEN$ <> "IF" THEN 4090
  37. 4070   GOSUB 40000 'proc if
  38. 4080   RETURN
  39. 4090 IF TOKEN$ <> "ELSE" THEN 4120
  40. 4100   GOSUB 40500 'proc else
  41. 4110   RETURN
  42. 4120 IF TOKEN$ <> "ELSEIF" THEN 4150
  43. 4130   GOSUB 41000 'proc elseif
  44. 4140   RETURN
  45. 4150 IF TOKEN$ <> "ENDIF" THEN 4170
  46. 4160   GOSUB 41500 'proc endif
  47. 4165   RETURN
  48. 4170 IF TOKEN$ <> "REPEAT" THEN 4200
  49. 4180   GOSUB 42000 'proc repeat
  50. 4190   RETURN
  51. 4200 IF TOKEN$ <> "WHILE" THEN 4230
  52. 4210   GOSUB 42500 'proc while
  53. 4220   RETURN
  54. 4230 IF TOKEN$ <> "UNTIL" THEN 4260
  55. 4240   GOSUB 43000 'proc until
  56. 4250   RETURN
  57. 4260 IF TOKEN$ <> "ENDREP" THEN 4320
  58. 4270   GOSUB 43500 'proc endrep
  59. 4280   RETURN
  60. 4320 IF TOKEN$ <> "DO" THEN 4350
  61. 4330   GOSUB 44500 'proc do
  62. 4340   RETURN
  63. 4350 IF TOKEN$ <> "PROCEDURE" THEN 4380
  64. 4360   GOSUB 45000 'proc procedure
  65. 4370   RETURN
  66. 4380 IF TOKEN$ <> "ENDPROC" THEN 4600
  67. 4390   GOSUB 45500 'proc endproc
  68. 4400   RETURN
  69. 4600 'endif
  70. 4660 GOSUB 59000 'copy to eol
  71. 4670 GOSUB 30200 'putline
  72. 4999 RETURN
  73. 10000 '----------
  74. 10010 ' initialize
  75. 10020 '
  76. 10030 GOSUB 21000 'init scan
  77. 10040 GOSUB 30000 'init put
  78. 10050 GOSUB 30500 'init labtabs
  79. 10060 GOSUB 30700 'init labstk
  80. 10070 GOSUB 31500 'init readline
  81. 10080 GOSUB 900   'define functions
  82. 10090 GOSUB 50000 'init symtabs
  83. 10100 GOSUB 53000 'init files
  84. 10110 GOSUB 51000 'init screen
  85. 10999 RETURN
  86. 20000 '----------
  87. 20010 'scan --
  88. 20020 '  sets 'token$' = next token in 'inline$'
  89. 20030 '       'ttype'  = token class
  90. 20040 '
  91. 20050 IF ASC(CHAR$)<>EOL AND ASC (CHAR$) <> 12 THEN 20090
  92. 20060   TTYPE=EOL
  93. 20070   TOKEN$=""
  94. 20080   GOTO 20550
  95. 20090 'elseif
  96. 20100 IF ASC(CHAR$)<>&O42 THEN 20140
  97. 20110   GOSUB 21500 'proc quoted
  98. 20130   GOTO 20550
  99. 20140 'elseif
  100. 20280 IF CHAR$<>"@" THEN 20390
  101. 20290   GOSUB 21400 'nxtc u
  102. 20360   GOSUB 23110 'proc ulab
  103. 20380   GOTO 20550
  104. 20390 'elseif
  105. 20400 IF NOT FNALPHA(CHAR$) THEN 20430
  106. 20420   GOSUB 23300 'proc name
  107. 20425   GOTO 20550
  108. 20430 'else
  109. 20440   IF CHAR$<>" " AND ASC(CHAR$) <> 9 THEN 20500
  110. 20450     TOKEN$=" "
  111. 20460     TTYPE=ASC(" ")
  112. 20470     GOSUB 21400 'nxtc u
  113. 20480     IF CHAR$=" " THEN 20470
  114. 20490     GOTO 20540
  115. 20500   'else
  116. 20510     TOKEN$=CHAR$
  117. 20520     TTYPE=ASC(CHAR$)
  118. 20530     GOSUB 21400 'nxtc u
  119. 20540   'endif
  120. 20550 'endif
  121. 20560 RETURN
  122. 20999 RETURN
  123. 21000 '----------
  124. 21010 ' init scan
  125. 21020 '
  126. 21030 EOL=1
  127. 21040 QSTR=2
  128. 21060 GLAB=3
  129. 21070 ULAB=4
  130. 21080 SNAME=5
  131. 21090 SCANERROR=6
  132. 21199 RETURN
  133. 21200 '----------
  134. 21210 ' init line scan
  135. 21220 '
  136. 21230 INLINELEN=LEN(INLINE$)
  137. 21240 INI=1
  138. 21250 GOSUB 21400 'nxtc u
  139. 21299 RETURN
  140. 21300 '----------
  141. 21310 ' nxtc -- sets 'char$' to next input character
  142. 21320 '
  143. 21330 IF INI<=INLINELEN THEN 21350
  144. 21340   CHAR$=CHR$(EOL)
  145. 21345   GOTO 21380
  146. 21350 'else
  147. 21360   CHAR$=MID$(INLINE$,INI,1)
  148. 21370   INI=INI+1
  149. 21380 'endif
  150. 21390 RETURN
  151. 21400 '----------
  152. 21410 ' nxtc u
  153. 21420 '
  154. 21430 GOSUB 21300 'nxtc
  155. 21440 CHAR$=FNUPPER$(CHAR$)
  156. 21499 RETURN
  157. 21500 '----------
  158. 21510 ' proc quoted
  159. 21520 '
  160. 21530 TOKEN$=CHR$(&O42)
  161. 21535 PQLEN=0
  162. 21540 GOSUB 21300 'nxtc
  163. 21550 IF ASC(CHAR$)=&O42 OR PQLEN=255 THEN 21590
  164. 21560   TOKEN$=TOKEN$+CHAR$
  165. 21570   PQLEN=PQLEN+1
  166. 21575   GOSUB 21300 'nxtc
  167. 21580   GOTO 21550
  168. 21590 'endloop
  169. 21600 IF PQLEN<255 THEN 21660
  170. 21610   ERMSG$="String too long"
  171. 21620   GOSUB 60000 'error
  172. 21630   TTYPE=SCANERROR
  173. 21640   TOKEN$=""
  174. 21650   GOTO 21690
  175. 21660 'else
  176. 21670   TOKEN$=TOKEN$+CHR$(&O42)
  177. 21680   TTYPE=QSTR
  178. 21685   GOSUB 21400 'nxtc u
  179. 21690 'endif
  180. 21799 RETURN
  181. 23100 '----------
  182. 23110 ' proc ulab
  183. 23120 '
  184. 23130 GOSUB 23300 'proc name
  185. 23140 IF TTYPE=SNAME THEN 23190
  186. 23150   ERMSG$="Improper user label"
  187. 23160   GOSUB 60000 'error
  188. 23170   TTYPE=SCANERROR
  189. 23180   TOKEN$=""
  190. 23185   GOTO 23210
  191. 23190 'else
  192. 23200   TTYPE=ULAB
  193. 23210 'endif
  194. 23299 RETURN
  195. 23300 '----------
  196. 23310 ' proc name
  197. 23320 '
  198. 23330 IF FNALPHA(CHAR$) THEN 23380
  199. 23340   ERMSG$="Improper name"
  200. 23350   GOSUB 60000 'error
  201. 23360   TTYPE=SCANERROR
  202. 23370   GOTO 23490
  203. 23380 'else
  204. 23385   TOKEN$=""
  205. 23390   IF (NOT FNALPHA(CHAR$)) AND (NOT FNNUMERIC(CHAR$)) THEN 23440
  206. 23400     TOKEN$=TOKEN$+CHAR$
  207. 23410     GOSUB 21400 'nxtc u
  208. 23420     GOTO 23390
  209. 23430   'endloop
  210. 23440   IF CHAR$<>"#" AND CHAR$<>"%" AND CHAR$<>"$" AND CHAR$<>"!" THEN 23470
  211. 23450     TOKEN$=TOKEN$+CHAR$
  212. 23460     GOSUB 21400 'nextc u
  213. 23470   'endif
  214. 23480   TTYPE=SNAME
  215. 23490 'endif
  216. 23999 RETURN
  217. 30000 '----------
  218. 30010 ' init put
  219. 30020 '
  220. 30030 OUTLINE$=" 10 "
  221. 30040 OUTNUM=10
  222. 30045 OUTINC=10
  223. 30099 RETURN
  224. 30100 '----------
  225. 30110 ' put -- appends 'out$' to 'outline$'
  226. 30120 '
  227. 30130 OUTLINE$=OUTLINE$+POUT$
  228. 30199 RETURN
  229. 30200 '----------
  230. 30210 ' putline
  231. 30220 '
  232. 30230 PRINT# OUTCHAN,OUTLINE$
  233. 30240 OUTNUM=OUTNUM+OUTINC
  234. 30250 OUTLINE$=STR$(OUTNUM)+" "
  235. 30499 RETURN
  236. 30500 '----------
  237. 30510 ' init labtabs
  238. 30520 '
  239. 30530 NEXTGLAB=65529!
  240. 30540 NEXTULAB=0
  241. 30599 RETURN
  242. 30600 '----------
  243. 30610 ' genlab -- sets 'label$', 'labelval'
  244. 30620 '
  245. 30630 LABEL$=STR$(NEXTGLAB)
  246. 30640 LABELVAL=NEXTGLAB
  247. 30650 NEXTGLAB=NEXTGLAB-1
  248. 30699 RETURN
  249. 30700 '----------
  250. 30710 ' init labstk
  251. 30720 '
  252. 30730 LABTOP=0
  253. 30799 RETURN
  254. 30800 '----------
  255. 30810 ' pushlab -- pushes 'labelval'
  256. 30820 '
  257. 30830 LABSTK(LABTOP)=LABELVAL
  258. 30840 LABTOP=LABTOP+1
  259. 30850 IF LABTOP>25 THEN PRINT "Label stack overflow": STOP
  260. 30899 RETURN
  261. 30900 '----------
  262. 30910 ' poplab -- pops 'labelval', set label$
  263. 30920 '
  264. 30930 LABTOP=LABTOP-1
  265. 30940 IF LABTOP<0 THEN PRINT "Label stack underflow": STOP
  266. 30950 LABELVAL=LABSTK(LABTOP)
  267. 30960 LABEL$=STR$(LABELVAL)
  268. 30999 RETURN
  269. 31000 '----------
  270. 31010 ' readline -- reads 'inline$'
  271. 31020 '
  272. 31030 LINE INPUT# INCHAN,INLINE$
  273. 31040 GOSUB 21200 'init line scan
  274. 31499 RETURN
  275. 31500 '----------
  276. 31510 ' init readline
  277. 31520 '
  278. 31999 RETURN
  279. 40000 '----------
  280. 40010 ' proc if
  281. 40020 '
  282. 40030 GOSUB 30600 'genlab
  283. 40040 GOSUB 30800 'pushlab
  284. 40050 GOSUB 30600 'genlab
  285. 40060 GOSUB 30800 'pushlab
  286. 40070 POUT$="IF NOT("
  287. 40080 GOSUB 30100 'put
  288. 40090 GOSUB 50500 'scan nb
  289. 40120 GOSUB 59000 'copy to eol
  290. 40130 POUT$=") THEN "+LABEL$
  291. 40140 GOSUB 30100 'put
  292. 40150 GOSUB 30200 'putline
  293. 40499 RETURN
  294. 40500 '----------
  295. 40510 ' proc else
  296. 40520 '
  297. 40530 GOSUB 30900 'poplab
  298. 40540 TVAL1=LABELVAL
  299. 40560 GOSUB 30900 'poplab
  300. 40570 POUT$="GOTO "+LABEL$
  301. 40580 GOSUB 30100 'put
  302. 40590 GOSUB 30200 'putline
  303. 40592 TVAL2=LABELVAL
  304. 40594 LABELVAL=TVAL1
  305. 40596 GOSUB 50100 'place glab
  306. 40598 LABELVAL=TVAL2
  307. 40620 GOSUB 30800 'pushlab
  308. 40630 GOSUB 30800 'pushlab
  309. 40999 RETURN
  310. 41000 '----------
  311. 41010 ' proc elseif
  312. 41020 '
  313. 41030 GOSUB 30900 'poplab
  314. 41040 TVAL1=LABELVAL
  315. 41060 GOSUB 30900 'poplab
  316. 41070 POUT$="GOTO "+LABEL$
  317. 41080 GOSUB 30100 'put
  318. 41090 GOSUB 30200 'putline
  319. 41092 TVAL2=LABELVAL
  320. 41094 LABELVAL=TVAL1
  321. 41096 GOSUB 50100 'place glab
  322. 41098 LABELVAL=TVAL2
  323. 41120 GOSUB 30800 'pushlab
  324. 41130 GOSUB 30600 'genlab
  325. 41135 GOSUB 30800 'pushlab
  326. 41140 POUT$="IF NOT("
  327. 41150 GOSUB 30100 'put
  328. 41160 GOSUB 50500 'scan nb
  329. 41190 GOSUB 59000 'copy to eol
  330. 41200 POUT$=") THEN "+LABEL$
  331. 41210 GOSUB 30100 'put
  332. 41220 GOSUB 30200 'putline
  333. 41499 RETURN
  334. 41500 '----------
  335. 41510 ' proc endif
  336. 41520 '
  337. 41530 GOSUB 30900 'poplab
  338. 41531 GOSUB 50100 'place glab
  339. 41535 GOSUB 30900 'poplab
  340. 41540 GOSUB 50100 'place glab
  341. 41999 RETURN
  342. 42000 '----------
  343. 42010 ' proc repeat
  344. 42020 '
  345. 42030 GOSUB 30600 'genlab
  346. 42040 GOSUB 30800 'pushlab
  347. 42050 GOSUB 50100 'place glab
  348. 42070 GOSUB 30600 'genlab
  349. 42080 GOSUB 30800 'pushlab
  350. 42090 GOSUB 50500 'scan nb
  351. 42100 IF TTYPE <> SNAME OR TOKEN$ <> "WHILE" THEN 42130
  352. 42110   GOSUB 42500 'proc while
  353. 42120   GOTO 42170
  354. 42130 IF TTYPE <> SNAME OR TOKEN$ <> "UNTIL" THEN 42170
  355. 42140   GOSUB 43000 'proc until
  356. 42170 'endif
  357. 42499 RETURN
  358. 42500 '----------
  359. 42510 ' proc while
  360. 42520 '
  361. 42530 GOSUB 30900 'poplab
  362. 42540 GOSUB 30800 'pushlab
  363. 42550 POUT$="IF NOT("
  364. 42560 GOSUB 30100 'put
  365. 42580 GOSUB 50500 'scan nb
  366. 42590 GOSUB 59000 'copy to eol
  367. 42600 POUT$=") THEN "+LABEL$
  368. 42605 GOSUB 30100 'put
  369. 42610 GOSUB 30200 'putline
  370. 42999 RETURN
  371. 43000 '----------
  372. 43010 ' proc until
  373. 43020 '
  374. 43030 GOSUB 30900 'poplab
  375. 43040 GOSUB 30800 'pushlab
  376. 43050 POUT$="IF "
  377. 43060 GOSUB 30100 'put
  378. 43080 GOSUB 50500 'scan nb
  379. 43090 GOSUB 59000 'copy to eol
  380. 43100 POUT$=" THEN "+LABEL$
  381. 43110 GOSUB 30100 'put
  382. 43120 GOSUB 30200 'putline
  383. 43499 RETURN
  384. 43500 '----------
  385. 43510 ' proc endrep
  386. 43520 '
  387. 43530 GOSUB 30900 'poplab
  388. 43550 TVAL1=LABELVAL
  389. 43560 GOSUB 30900 'poplab
  390. 43570 POUT$="GOTO "+LABEL$
  391. 43580 GOSUB 30100 'put
  392. 43590 GOSUB 30200 'putline
  393. 43592 LABELVAL=TVAL1
  394. 43594 GOSUB 50100 'place glab
  395. 43999 RETURN
  396. 44000 '----------
  397. 44010 ' proc include
  398. 44020 '
  399. 44499 RETURN
  400. 44500 '----------
  401. 44510 ' proc do
  402. 44520 '
  403. 44550 GOSUB 50500 'scan nb
  404. 44560 IF TTYPE=SNAME THEN 44600
  405. 44570   ERMSG$="Procedure name missing"
  406. 44580   GOSUB 60000 'error
  407. 44590   RETURN
  408. 44600 'endif
  409. 44610 POUT$="GOSUB "
  410. 44620 GOSUB 30100 'put
  411. 44630 GOSUB 50200 'ulab ref
  412. 44700 GOSUB 30200 'putline
  413. 44710 GOSUB 50600 'vfy eol
  414. 44999 RETURN
  415. 45000 '----------
  416. 45010 ' proc procedure
  417. 45020 '
  418. 45030 GOSUB 50500 'scan nb
  419. 45040 IF TTYPE=SNAME THEN 45080
  420. 45050   ERMSG$="Missing procedure name"
  421. 45060   GOSUB 60000 'error
  422. 45070   RETURN
  423. 45080 POUT$="'----"+TOKEN$
  424. 45090 GOSUB 30100 'put
  425. 45100 GOSUB 46000 'def ulab
  426. 45160 GOSUB 30200 'putline
  427. 45170 GOSUB 50600 'vfy eol
  428. 45499 RETURN
  429. 45500 '----------
  430. 45510 ' proc endproc
  431. 45520 '
  432. 45530 POUT$="RETURN"
  433. 45540 GOSUB 30100 'put
  434. 45550 GOSUB 30200 'putline
  435. 45560 GOSUB 50600 'vfy eol
  436. 45599 RETURN
  437. 46000 '----------
  438. 46010 ' def ulab
  439. 46020 '
  440. 46030 GOSUB 50300 'lookup ulab
  441. 46040 IF LABELINDEX<0 THEN 46130
  442. 46050   IF LABELLOC<0 THEN 46090
  443. 46060     ERMSG$="multiple definition: "+TOKEN$
  444. 46070     GOSUB 60000 'error
  445. 46080     GOTO 46110
  446. 46090   'else
  447. 46095     GLABVALS(65529!+LABELLOC)=OUTNUM
  448. 46100     ULABVALS(LABELINDEX)=OUTNUM
  449. 46110   'endif
  450. 46120   GOTO 46180
  451. 46130 'else
  452. 46140   ULABVALS(NEXTULAB)=OUTNUM
  453. 46150   ULABTEXT$(NEXTULAB)=TOKEN$
  454. 46160   NEXTULAB=NEXTULAB+1
  455. 46170   IF NEXTULAB>1000 THEN PRINT "Too many labels" : STOP
  456. 46180 'endif
  457. 46190 GOSUB 50500 'scan nb 'consume : if pres. else fetch eol
  458. 46499 RETURN
  459. 50000 '----------
  460. 50010 ' init symtabs
  461. 50020 '
  462. 50030 FOR I=0 TO 1000
  463. 50040   GLABVALS(I)=-1
  464. 50050   ULABVALS(I)=-1
  465. 50060 NEXT
  466. 50070 NEXTULAB=0
  467. 50099 RETURN
  468. 50100 '----------
  469. 50110 ' place glab
  470. 50120 '
  471. 50130 GLABVALS(65529!-LABELVAL)=OUTNUM
  472. 50199 RETURN
  473. 50200 '----------
  474. 50205 ' ulab ref
  475. 50210 '
  476. 50215 GOSUB 50300 'lookup ulab
  477. 50220 IF LABELINDEX>=0 THEN 50245
  478. 50225   LABELINDEX=NEXTULAB: NEXTULAB=NEXTULAB+1
  479. 50230   ULABTEXT$(LABELINDEX)=TOKEN$
  480. 50235   GOSUB 30600 'genlab
  481. 50240   ULABVALS(LABELINDEX)=-LABELVAL
  482. 50245 'endif
  483. 50250 POUT$=STR$(ABS(ULABVALS(LABELINDEX)))
  484. 50255 GOSUB 30100 'put
  485. 50299 RETURN
  486. 50300 '----------
  487. 50310 ' lookup ulab -- label in 'token$', sets 'labelloc', 'labelindex'
  488. 50320 '
  489. 50340 IF NEXTULAB=0 THEN LABELINDEX=-1: RETURN
  490. 50350 FOR LABELINDEX=0 TO NEXTULAB-1
  491. 50360   IF ULABTEXT$(LABELINDEX)<>TOKEN$ THEN 50390
  492. 50370   LABELLOC=ULABVALS(LABELINDEX)
  493. 50380   RETURN
  494. 50390 NEXT
  495. 50400 LABELINDEX=-1
  496. 50499 RETURN
  497. 50500 '----------
  498. 50510 ' scan nb
  499. 50520 '
  500. 50530 GOSUB 20000 'scan
  501. 50540 IF TOKEN$=" " THEN 50530
  502. 50599 RETURN
  503. 50600 '----------
  504. 50610 ' vfy eol
  505. 50620 '
  506. 50630 GOSUB 50500 'scan nb
  507. 50640 IF TTYPE=EOL OR TTYPE=CDELIM THEN RETURN
  508. 50650 ERMSG$="Extraneous words after statement"
  509. 50660 GOSUB 60000 'error
  510. 50699 RETURN
  511. 51000 '----------
  512. 51010 ' init screen
  513. 51020 '
  514. 51030 CLS
  515. 51040 LOCATE 1,1: PRINT USING "\      \ XB V1.00 (13-Mar-83)";TIME$;
  516. 51099 RETURN
  517. 53000 '----------
  518. 53010 ' init files
  519. 53020 '
  520. 53030 INCHAN=1
  521. 53040 OUTCHAN=2
  522. 53050 INPUT "Input file: ",INNAME$
  523. 53060 INPUT "Output file: ",OUTNAME$
  524. 53070 OPEN INNAME$ FOR INPUT AS INCHAN
  525. 53080 OPEN OUTNAME$ FOR OUTPUT AS OUTCHAN
  526. 53090 RETURN
  527. 55000 '----------
  528. 55010 ' pass 2
  529. 55020 '
  530. 55030 GOSUB 30000 'init put
  531. 55040 OUTNUM=65529!
  532. 55045 OUTLINE$="65529 "
  533. 55050 OUTINC=-1
  534. 55060 PATCHNR=0
  535. 55070 WHILE OUTNUM>NEXTGLAB
  536. 55080   POUT$=" GOTO "+STR$(GLABVALS(PATCHNR))
  537. 55090   GOSUB 30100 'put
  538. 55100   GOSUB 30200 'putline
  539. 55105   PATCHNR=PATCHNR+1
  540. 55110 WEND
  541. 55199 RETURN
  542. 55200 '----------
  543. 55210 ' finish ulabs
  544. 55220 '
  545. 55230 IF NEXTULAB=0 THEN RETURN
  546. 55240 FOR I=0 TO NEXTULAB-1
  547. 55250   IF ULABVALS(I)>=0 THEN 55300
  548. 55260     ERMSG$="Undefined label: "+ULABTEXT$(I)
  549. 55270     GOSUB 60000 'error
  550. 55300   'endif
  551. 55310 NEXT
  552. 55320 RETURN
  553. 55500 '----------
  554. 55510 'finish errs
  555. 55520 '
  556. 55530 CLS
  557. 55540 IF ERCNT=0 THEN PRINT "No errors detected" ELSE PRINT USING "#### error(s) detected"; ERCNT
  558. 55599 RETURN
  559. 59000 '----------
  560. 59010 ' copy to eol
  561. 59020 '
  562. 59030 WHILE TTYPE<>EOL
  563. 59040   IF TTYPE<>ULAB THEN 59100
  564. 59050     GOSUB 50200 'ulab ref
  565. 59060     GOTO 59200
  566. 59100   'else
  567. 59110     POUT$=TOKEN$
  568. 59120     GOSUB 30100 'put
  569. 59200   'endif
  570. 59205   GOSUB 20000 'scan
  571. 59210 WEND
  572. 59299 RETURN
  573. 60000 '----------
  574. 60010 ' error -- displays 'ermsg$'
  575. 60020 '
  576. 60030 ERCNT=ERCNT+1
  577. 60040 PRINT "XB Error: ";
  578. 60050 PRINT ERMSG$
  579. 60070 RETURN
  580.